Código
# Librerias
library(readxl)
library(dplyr)
library(tidyr)
library(ggplot2)
library(lubridate)
library(stringr)
library(writexl)
library(kableExtra)
library(plotly)

MANEJO DE DATOS

RONCAGLIA, Andrés | SANTINI, Franco

Primer trabajo práctico de Bioestadística

Facultad de Ciencias Económicas y Estadística, UNR

Introducción

Se llevó a cabo un estudio de investigación clínica multicéntrico con el fin de implementar estándares mundiales de crecimiento fetal que faciliten la detección temprana de alteraciones en el desarrollo del feto dentro del últero, y de esta manera reducir la morbi-mortalidad perinatal asociada con el crecimiento. Durante el período de reclutamiento, las mujeres admitidas en alguna de las clínicas de salud participantes cursando su primer trimestre de embarazo fueron invitadas a formar parte del estudio. Aquellas que cumplieron con los criterios de elegibilidad y dieron su consentimiento fueron seguidas según un esquema de visitas programado a las 14, 18, 24, 28, 32, 36 y 40 semanas de gestación. En cada visita, se tomaron medidas antropométricas del feto por medio de un ultrasonido.

La información necesaria para llevar a cabo el análisis se recolectó a lo largo de 17 formularios en papel. Particularmente, en el formulario de admisión (ADM) se registraron algunas características de la mujeres al momento de ingresar en el estudio. A las mujeres que cumplieron todos los criterios les fue asignado un código identificador único (Subject Number) compuesto por su código de país, código del médico responsable, y el orden de ingreso. Sólo se entrevistaron mujeres mayores de edad (18 años o más al momento de la entrevista).

Estos datos son digitalizados manualmente lo cúal puede llevar a numerosas inconsistencias y errores ya sean por parte de quien completa el formulario y/o de quien lo digitaliza. Es importante entonces establecer un conjunto de reglas para que la información recopilada este limpia de estas inconsistencias, alertando cada vez que un registro viole alguna de las reglas, a esto lo llamamos validación.

Código
# Carga de datos

datos <- read_xlsx('Datos/adm.xlsx')

# Extraemos la fecha de nacimiento y las inciales de la persona

ids <- str_split(datos$patientid, pattern = '-')

datos$bdate <-  sapply(ids, function(x) x[1])
datos$initials <-  sapply(ids, function(x) x[2])

# Pasamos a formato fecha las variables correspondientes y calculamos la edad antes de la entrevista

datos <- datos |> mutate(interview = as.Date(interview, format = '%d/%m/%Y'),
                bdate = as.Date(bdate, format = '%d/%m/%Y'),
                age = round(as.numeric(interview - bdate)/365,2),
                ind_id = 1:nrow(datos))

Las variables que se extrajeron de los formularios son las siguientes:

Código
data.frame(Variable = names(datos)[1:8],
           Tipo = c("Numérico", "Caracter", "Fecha", "Numérico", "Numérico", "Numérico", "Numérico", "Caracter"),
           Descripcion = c("Código del país", "Identificador del paciente", "Fecha de la entrevista", "Grupo étnico", "Elegibilidad según forma CLIN-SCR", "Elegibilidad según forma US-SCR", "Consentimiento", "Número de sujeto"),
           Valores = c("4, 11, 14, 23, 31, 48, 54, 65, 72, 97", "dd/mm/yyyy-AA", "dd/mm/yyyy", "1 = 'Caucásico', 2 = 'Asiático', 3 = 'Africano', 4 = 'Otro'", "1 = 'NO', 2 = 'YES'", "1 = 'NO', 2 = 'YES'", "1 = 'NO', 2 = 'YES'", "countrycode-physiciancode-subjectcode")
           ) |> kable(format = 'pipe') |> 
  kable_styling() %>%
  row_spec(0, background = "skyblue2", color = "black", bold = T) %>%
  row_spec(1:8, background = "#f2f3f4" ,color = "black")
Variable Tipo Descripcion Valores
countrycode Numérico Código del país 4, 11, 14, 23, 31, 48, 54, 65, 72, 97
patientid Caracter Identificador del paciente dd/mm/yyyy-AA
interview Fecha Fecha de la entrevista dd/mm/yyyy
ethnicgroup Numérico Grupo étnico 1 = 'Caucásico', 2 = 'Asiático', 3 = 'Africano', 4 = 'Otro'
scr Numérico Elegibilidad según forma CLIN-SCR 1 = 'NO', 2 = 'YES'
usscr Numérico Elegibilidad según forma US-SCR 1 = 'NO', 2 = 'YES'
consent Numérico Consentimiento 1 = 'NO', 2 = 'YES'
subjectnumber Caracter Número de sujeto countrycode-physiciancode-subjectcode


A partir de estas variables, se crearon las siguientes:

Código
data.frame(Variable = names(datos)[9:length(names(datos))],
           Tipo = c("Fecha", "Caracter", "Numérico", "Numérico"),
           Descripcion = c("Fecha de nacimiento", "Iniciales del paciente", "Edad del paciente", "Identificador numérico del paciente"),
           Valores = c("dd/mm/yyyy", "AA", "18 a 51", "1 a 1000")
           ) |> kable(format = 'pipe') |> 
  kable_styling() %>%
  row_spec(0, background = "skyblue2", color = "black", bold = T) %>%
  row_spec(1:4, background = "#f2f3f4" ,color = "black")
Variable Tipo Descripcion Valores
bdate Fecha Fecha de nacimiento dd/mm/yyyy
initials Caracter Iniciales del paciente AA
age Numérico Edad del paciente 18 a 51
ind_id Numérico Identificador numérico del paciente 1 a 1000

Reglas propuestas

Dada la naturaleza del problema se definieron las siguientes reglas:

Código
#https://centrofertilidad.com/blog/hasta-que-edad-una-mujer-es-fertil/#elementor-toc__heading-anchor-0

# Creacion de reglas --------------------

## Condiciones de las reglas ----------------

condiciones = c(
  'is.na(countrycode)',
  '!is.numeric(countrycode)',
  '!(countrycode %in% c(4,11,14,23,31,48,54,65,72,97))',
  'is.na(patientid)',
  'is.na(bdate)',
  '!is.Date(bdate)',
  'is.na(initials)',
  '!is.character(initials)',
  'str_length(initials) != 2',
  'initials != str_to_upper(initials)',
  'is.na(interview)',
  '!is.Date(interview)',
  'age < 18 | age > 51',
  'is.na(ethnicgroup)',
  '!is.numeric(ethnicgroup)',
  '!(ethnicgroup %in% 1:4)',
  'is.na(scr)',
  '!is.numeric(scr)',
  '!(scr %in% 1:2)',
  'is.na(usscr)',
  '!is.numeric(usscr)',
  '!(usscr %in% 1:2)',
  'is.na(consent)',
  '!is.numeric(consent)',
  '!(consent %in% 1:2)',
  '(consent == 1 | scr == 1 | usscr == 1) & !(is.na(subjectnumber))',
  '(consent == 2 & scr == 2 & usscr == 2) & is.na(subjectnumber)',
  'ifelse(is.na(subjectnumber), FALSE, !(is.character(subjectnumber)))',
  'ifelse(is.na(subjectnumber), FALSE, str_length(subjectnumber) != 9)',
  'ifelse(is.na(subjectnumber), FALSE, as.numeric(str_sub(subjectnumber, end = 3)) != countrycode)'
)

## Descripcion de las reglas --------------------

desc <- c(
  '(countrycode) es faltante',
  '(countrycode) no es numérica',
  '(countrycode) no está entre las opciones',
  '(patientid) es faltante',
  '(bdate) es faltante',
  '(bdate) no es fecha',
  '(initials) es faltante',
  '(initials) no es caracter',
  '(initials) no es de largo 2',
  '(initials) no está en mayusculas',
  '(interview) es faltante',
  '(interview) no es fecha',
  '(age) fuera de rango (18 <= age <= 51)',
  '(ethnicgroup) es faltante',
  '(ethnicgroup) no es numérica',
  '(ethnicgroup) no está entre las opciones',
  '(scr) es faltante',
  '(scr) no es numérica',
  '(scr) no está entre las opciones',
  '(usscr) es faltante',
  '(usscr) no es numérica',
  '(usscr) no está entre las opciones',
  '(consent) es faltante',
  '(consent) no es numérica',
  '(consent) no está entre las opciones',
  'Si (scr), (usscr) o (consent) igual a 1, (subjectnumber) debe ser faltante',
  'Si (scr), (usscr) y (consent) igual a 2, (subjectnumber) no debe ser faltante',
  'Si (subjectnumber) no es faltante, (subjectnumber) debe ser caracter',
  'Si (subjectnumber) no es faltante, el largo de (subjectnumber) debe ser igual a 9',
  'Si (subjectnumber) no es faltante, los 3 primeros valores de (subjectnumber) deben coincidir con (countrycode)'
)

campo <- c(
  'Country Code',
  'Country Code',
  'Country Code',
  'Patients ID',
  'Patients ID',
  'Patients ID',
  'Patients ID',
  'Patients ID',
  'Patients ID',
  'Patients ID',
  'Interview',
  'Interview',
  'Patients ID',
  'Ethnic Group',
  'Ethnic Group',
  'Ethnic Group',
  'SSR',
  'SSR',
  'SSR',
  'USSSR',
  'USSSR',
  'USSSR',
  'Consent',
  'Consent',
  'Consent',
  'Subject Number',
  'Subject Number',
  'Subject Number',
  'Subject Number',
  'Subject Number'
)

tipo = c(
  "Existencia",
  "Consistencia",
  "Rango",
  "Existencia",
  "Existencia",
  "Consistencia",
  "Existencia",
  "Consistencia",
  "Rango",
  "Rango",
  "Existencia",
  "Consistencia",
  "Rango",
  "Existencia",
  "Consistencia",
  "Rango",
  "Existencia",
  "Consistencia",
  "Rango",
  "Existencia",
  "Consistencia",
  "Rango",
  "Existencia",
  "Consistencia",
  "Rango",
  "Consistencia",
  "Consistencia",
  "Consistencia",
  "Consistencia",
  "Consistencia"
)

id = paste0('r.', 1:length(condiciones))

## Dataframe reglas ------------------------

reglas <- data.frame(
  id = id,
  descripcion = desc,
  condicion = condiciones,
  tipo = tipo,
  campo = campo
)

## Guardamos las reglas como excel

write_xlsx(x = reglas, path = 'conjunto_validacion.xlsx')
Código
kable(reglas, col.names = c("ID", "Descripción", "Condición", "Tipo", "Campo")) |> 
  kable_styling() %>%
  row_spec(0, background = "skyblue2", color = "black", bold = T) %>%
  row_spec(1:nrow(reglas), background = "#f2f3f4" ,color = "black") |> 
  scroll_box(height = '300px')
ID Descripción Condición Tipo Campo
r.1 (countrycode) es faltante is.na(countrycode) Existencia Country Code
r.2 (countrycode) no es numérica !is.numeric(countrycode) Consistencia Country Code
r.3 (countrycode) no está entre las opciones !(countrycode %in% c(4,11,14,23,31,48,54,65,72,97)) Rango Country Code
r.4 (patientid) es faltante is.na(patientid) Existencia Patients ID
r.5 (bdate) es faltante is.na(bdate) Existencia Patients ID
r.6 (bdate) no es fecha !is.Date(bdate) Consistencia Patients ID
r.7 (initials) es faltante is.na(initials) Existencia Patients ID
r.8 (initials) no es caracter !is.character(initials) Consistencia Patients ID
r.9 (initials) no es de largo 2 str_length(initials) != 2 Rango Patients ID
r.10 (initials) no está en mayusculas initials != str_to_upper(initials) Rango Patients ID
r.11 (interview) es faltante is.na(interview) Existencia Interview
r.12 (interview) no es fecha !is.Date(interview) Consistencia Interview
r.13 (age) fuera de rango (18 <= age <= 51) age < 18 &#124; age > 51 Rango Patients ID
r.14 (ethnicgroup) es faltante is.na(ethnicgroup) Existencia Ethnic Group
r.15 (ethnicgroup) no es numérica !is.numeric(ethnicgroup) Consistencia Ethnic Group
r.16 (ethnicgroup) no está entre las opciones !(ethnicgroup %in% 1:4) Rango Ethnic Group
r.17 (scr) es faltante is.na(scr) Existencia SSR
r.18 (scr) no es numérica !is.numeric(scr) Consistencia SSR
r.19 (scr) no está entre las opciones !(scr %in% 1:2) Rango SSR
r.20 (usscr) es faltante is.na(usscr) Existencia USSSR
r.21 (usscr) no es numérica !is.numeric(usscr) Consistencia USSSR
r.22 (usscr) no está entre las opciones !(usscr %in% 1:2) Rango USSSR
r.23 (consent) es faltante is.na(consent) Existencia Consent
r.24 (consent) no es numérica !is.numeric(consent) Consistencia Consent
r.25 (consent) no está entre las opciones !(consent %in% 1:2) Rango Consent
r.26 Si (scr), (usscr) o (consent) igual a 1, (subjectnumber) debe ser faltante (consent == 1 &#124; scr == 1 &#124; usscr == 1) & !(is.na(subjectnumber)) Consistencia Subject Number
r.27 Si (scr), (usscr) y (consent) igual a 2, (subjectnumber) no debe ser faltante (consent == 2 & scr == 2 & usscr == 2) & is.na(subjectnumber) Consistencia Subject Number
r.28 Si (subjectnumber) no es faltante, (subjectnumber) debe ser caracter ifelse(is.na(subjectnumber), FALSE, !(is.character(subjectnumber))) Consistencia Subject Number
r.29 Si (subjectnumber) no es faltante, el largo de (subjectnumber) debe ser igual a 9 ifelse(is.na(subjectnumber), FALSE, str_length(subjectnumber) != 9) Consistencia Subject Number
r.30 Si (subjectnumber) no es faltante, los 3 primeros valores de (subjectnumber) deben coincidir con (countrycode) ifelse(is.na(subjectnumber), FALSE, as.numeric(str_sub(subjectnumber, end = 3)) != countrycode) Consistencia Subject Number


Código
# Evaluacion de reglas ------------------


# Funcion validador()
# argumentos:
# - datos: conjunto de validacion
# - id : nombre de la columna en (datos) con el identificador
# - cond : nombre de la columna en (datos) con la condicion
# salida: vector nombrado

validador <-  function(datos, id, cond) {
  
  reglas = datos[[cond]]
  names(reglas) = datos[[id]]
  reglas
  
}


# Funcion validar()
# argumentos:
# - datos : conjunto de datos a validar
# - id : nombre de la columna en (datos) con el identificador
# - validador: salida de validador()
# salida: tibble con el resultado de la validación

validar <- function(datos, id, validador) {
  sapply(
    validador,
    function(x) eval(parse(text = x), datos)
  ) |>
  as.data.frame() |>
  mutate(registro = datos[[id]], .before = 0)
}
Código
validacion <- validar(datos = datos, id = 'ind_id', validador = validador(datos = reglas, id = 'id', 'condicion'))

validacion_largo <- validacion |>
  pivot_longer(-registro, names_to = 'Regla', values_to = 'Error')
Código
# Individuos limpios

limpios <- validacion_largo |> 
  group_by(registro) |> 
  summarise('Errores' = sum(ifelse(is.na(Error), 1, Error))) |> 
  ungroup() |> 
  filter(Errores == 0) |> 
  count() |> 
  as.numeric()

# Participantes con inconsistencias

no_limpios <- nrow(datos)-limpios

# Inconsistencias mas frecuentes

inconsistencias <- validacion_largo |> 
  group_by(Regla) |> 
  summarise(Frecuencia = sum(ifelse(is.na(Error), 1, Error))) |> 
  ungroup() |> 
  arrange(desc(Frecuencia)) |> 
  head(7) |> 
  left_join(reglas, by = c('Regla' = 'id')) |> 
  select(Regla, descripcion, Frecuencia)


# Campos con mas errores

campos <- validacion_largo |> 
  group_by(Regla) |> 
  summarise(Frecuencia = sum(ifelse(is.na(Error), 1, Error))) |> 
  ungroup() |> 
  left_join(reglas, by = c('Regla' = 'id')) |> 
  group_by(campo) |> 
  summarise(Frecuencia = sum(Frecuencia))

Resultó de interés conocer las respuestas a las siguientes preguntas:

  • ¿Cúal es el número de participantes limpios (sin inconsistencias)?

    Hay un total de 761 pacientes sin inconsitencias.

  • ¿Cúantos participantes tienen inconsistencias?

    Dado que el total de pacientes son 1000, la cantidad de pacientes que tienen al menos una inconsistencia es 239.

  • ¿Cúales son las inconsistencias más frecuentes?

Código
a <- ggplot(inconsistencias) +
  aes(x = reorder(Regla, Frecuencia), y = Frecuencia, text = descripcion) + 
  geom_col(color = "black", fill = "firebrick", alpha = 0.7) + 
  theme_bw() +
  xlab("Regla") +
  ggtitle("Top 7 inconsistencias más frecuentes") +
  theme(legend.position = "none")

ggplotly(a, tolltip = "text")
  • ¿Qué campos presentan más errores?
Código
b <- campos |> 
  filter(Frecuencia > 0) |> 
  ggplot() +
  aes(x = reorder(campo, Frecuencia), y = Frecuencia) + 
  geom_col(color = "black", fill = "dodgerblue", alpha = 0.7) + 
  theme_bw() +
  xlab("Campo") +
  ggtitle("Cantidad de errores por campo") +
  theme(legend.position = "none")

ggplotly(b)

Recomendaciones finales

En base a los errores más comunes se debería recomendar a las personas que registran y digitalizan la información que presten más atención a los campos referidos al grupo étnico y al identificador del sujeto, en especial a las reglas 14, 30, 16, 26 y 27 que son las que se rompen con mayor frecuencia. Esto aceleraría el proceso de validación de datos logrando tener la información lista para el análisis en menor tiempo y con mayor calidad.